home *** CD-ROM | disk | FTP | other *** search
/ START Magazine / START VOL 4 NO 8.st / WIPES.ARC / SUSLSHOW.LST < prev    next >
Encoding:
File List  |  1989-12-06  |  7.8 KB  |  340 lines
  1. '
  2. '   Slide Show program by Heidi Brumbaugh
  3. '   Copyright 1990 Antic Publishing
  4. '   Uses wipes and dissolves routines by Carlos R. Tirado O.
  5. '
  6. Dim S%(5),D%(5),P%(8)
  7. Rez%=Xbios(4)
  8. Screen=Xbios(2)
  9. S1$=Space$(32256)
  10. Scrn1=(Int(Varptr(S1$)/256)+1)*256 ! Buffer used by wipe/dissolve routines
  11. S2$=Space$(32256)
  12. Scrn2=(Int(Varptr(S2$)/256)+1)*256 ! Used only in Rollup routine
  13. If Rez%=1 ! Don't use medium rez% (but this program would work if we did)
  14.   Void Xbios(5,L:-1,L:-1,W:0)
  15.   Cur_res%=0
  16. Else
  17.   Cur_res%=Rez%
  18. Endif
  19. Pct_res%=Cur_res%
  20. N_eff%=11
  21. N_pics%=4
  22. @Save_pal
  23. Palet$=Space$(32)
  24. Effect%=1
  25. Delay%=1
  26. Hidem
  27. Shown!=False
  28. Cls
  29. '
  30. Do
  31.   Restore
  32.   For I%=1 To N_pics%
  33.     Read Nam$
  34.     Nam$=Nam$+".pi"+Str$(Cur_res%+1)
  35.     If Not Exist(Nam$)
  36.       ' Skip it if file isn't there, but keep track so if no files are there
  37.       ' we can get out.
  38.       Inc Missing%
  39.       If Missing%>=N_pics% And Not Shown!
  40.         If Rez%<>Cur_res%
  41.           Void Xbios(5,L:-1,L:-1,W:Rez%)
  42.           Cur_res%=Rez%
  43.         Endif
  44.         Alert 3,"Can't do slideshow -- | pics are missing.",1,"Abort",D
  45.         @Done
  46.       Endif
  47.     Else
  48.       Shown!=True
  49.       If Effect%>N_eff%
  50.         Effect%=1
  51.       Endif
  52.       @Degasload
  53.       Pause Delay%
  54.       @Colorit
  55.       On Effect% Gosub Rollup,Rolldown,Scroll,Uncover,Cover,Venetian,Iris,Rndom,Cross,Assemble,Square
  56.       Inc Effect%
  57.     Endif
  58.     If Inkey$<>""
  59.       @Done
  60.     Endif
  61.   Next I%
  62. Loop
  63. '
  64. @Done
  65. Data pic_1,pic_2,pic_3,pic_4
  66. '
  67. Procedure Done
  68.   If Rez%<>Cur_res%
  69.     Void Xbios(5,L:-1,L:-1,W:Rez%)
  70.   Endif
  71.   @Restore_pal
  72.   End
  73. Return
  74. '
  75. Procedure Degasload
  76.   Open "I",#1,Nam$
  77.   Seek #1,2
  78.   Bget #1,Varptr(Palet$),32
  79.   Bget #1,Scrn1,32000
  80.   Close #1
  81. Return
  82. '
  83. Procedure Colorit
  84.   Local I%
  85.   For I%=0 To 15
  86.     Setcolor I%,Dpeek(Varptr(Palet$)+I%*2)
  87.   Next I%
  88. Return
  89. '
  90. '
  91. ' ------------- SAVE ORIGINAL COLOR PALETTE -----------------------
  92. Procedure Save_pal
  93.   '
  94.   Dim Spalette%(16,3)
  95.   '
  96.   For Z%=0 To 15
  97.     Dpoke Contrl,26
  98.     Dpoke Contrl+2,0
  99.     Dpoke Contrl+6,2
  100.     Dpoke Intin,Z%
  101.     Dpoke Intin+2,0
  102.     Vdisys
  103.     Spalette%(Z%,0)=Dpeek(Intout+2)
  104.     Spalette%(Z%,1)=Dpeek(Intout+4)
  105.     Spalette%(Z%,2)=Dpeek(Intout+6)
  106.   Next Z%
  107. Return
  108. '
  109. Procedure Restore_pal
  110.   ' --------------------- RESTORES PALETTE -------------------
  111.   ' Dimensions: Spalette%(16,3)
  112.   '
  113.   For Z%=0 To 15
  114.     Dpoke Contrl,14
  115.     Dpoke Contrl+2,0
  116.     Dpoke Contrl+6,4
  117.     Dpoke Intin,Z%
  118.     Dpoke Intin+2,Spalette%(Z%,0)
  119.     Dpoke Intin+4,Spalette%(Z%,1)
  120.     Dpoke Intin+6,Spalette%(Z%,2)
  121.     Vdisys
  122.   Next Z%
  123. Return
  124. '
  125. ' ======================================================================
  126. '                    GFA-BASIC Video Effects Routines
  127. ' ======================================================================
  128. ' ------------------------------
  129. '  BMOVE ROUTINES (Wipes)
  130. ' ------------------------------
  131. '
  132. '  This next subroutine  "rollup" is not included in the Slide Show
  133. '  program SUSLSHOW.BAS  If you intend to use it please note that
  134. '  it uses an additional 32000 bytes accessed by the pointer -scrn2-
  135. '
  136. Procedure Rollup
  137.   Bmove Screen,Scrn2,32000
  138.   For Ev=1 To 50
  139.     Bmove Screen+32000-160*(Ev+Ev-1),Screen+32000-160*(Ev+Ev+1),Ev*160
  140.     Bmove Scrn2+32000-160*(Ev+1),Screen+32000-160*(Ev+1),160
  141.     Bmove Scrn1+32000-160*Ev,Screen+32000-160*Ev,160
  142.   Next Ev
  143.   For Ev=98 Downto 0
  144.     Bmove Screen+160*Ev+320,Screen+160*Ev,7840
  145.     Bmove Scrn2+160*Ev+8160,Screen+160*Ev+7840,160
  146.     Bmove Scrn1+160*Ev+8000,Screen+160*Ev+8000,320
  147.   Next Ev
  148.   For Ev=7840 To 160 Step -160
  149.     Bmove Screen+320,Screen,Ev
  150.     Bmove Scrn2+Ev-160,Screen+Ev-160,160
  151.     Bmove Scrn1+Ev,Screen+Ev,160
  152.   Next Ev
  153.   Bmove Scrn1,Screen,160
  154. Return
  155. '
  156. Procedure Rolldown
  157.   For Ev=1 To 49
  158.     Bmove Screen,Screen+320,160*Ev
  159.     Bmove Scrn1+160*(Ev+Ev+1),Screen+160,160
  160.     Bmove Scrn1+160*(Ev+Ev+2),Screen,160
  161.   Next Ev
  162.   For Ev=0 To 98
  163.     Bmove Screen+160*Ev,Screen+160*Ev+320,7840
  164.     Bmove Scrn1+160*Ev,Screen+160*Ev,160
  165.     Bmove Scrn1+160*Ev+16160,Screen+160*Ev+160,160
  166.   Next Ev
  167.   For Ev=50 Downto 1
  168.     Bmove Screen+32000-160*(Ev+Ev+1),Screen+32000-160*(Ev+Ev-1),Ev*160
  169.     Bmove Scrn1+32000-160*(Ev+Ev+1),Screen+32000-160*(Ev+Ev+1),320
  170.   Next Ev
  171. Return
  172. '
  173. Procedure Scroll
  174.   For Ev=0 To 31680 Step 320
  175.     Bmove Screen+320,Screen,31680
  176.     Bmove Scrn1+Ev,Screen+31680,320
  177.   Next Ev
  178. Return
  179. '
  180. Procedure Uncover
  181.   For Ev=0 To 15840 Step 160
  182.     Bmove Screen+160,Screen,15840
  183.     Bmove Scrn1+Ev,Screen+15840,160
  184.     Bmove Screen+16000,Screen+16160,15840
  185.     Bmove Scrn1+31840-Ev,Screen+16000,160
  186.   Next Ev
  187. Return
  188. '
  189. Procedure Cover
  190.   For Ev=15840 To 0 Step -160
  191.     Bmove Scrn1+Ev,Screen,16000-Ev
  192.     Bmove Scrn1+16000,Screen+16000+Ev,16000-Ev
  193.   Next Ev
  194. Return
  195. '
  196. Procedure Venetian
  197.   Local Ev,Ev2
  198.   For Ev=0 To 7840 Step 160
  199.     For Ev2=0 To 24000 Step 8000
  200.       Bmove Scrn1+8000-Ev-160+Ev2,Screen+Ev2,Ev+160
  201.     Next Ev2
  202.   Next Ev
  203. Return
  204. ' ----------------------------------
  205. '   BIT BLIT ROUTINES (Dissolves)
  206. ' ----------------------------------
  207. '
  208. '  Don't forget to include in your program the next line:
  209. '        DIM s%(5),d%(5),p%(8)
  210. '
  211. Procedure Setup_bitblit
  212.   P%(0)=0                           ! p%()  coordinates & mode of Bit Blit
  213.   P%(8)=3
  214.   S%(0)=Scrn1                       ! s%() contains SFMDB
  215.   S%(1)=320-320*(Pct_res%<>0)
  216.   S%(2)=200-200*(Pct_res%=2)
  217.   S%(3)=Int((S%(1)+15)/16)
  218.   S%(4)=0
  219.   S%(5)=4-2*(Pct_res%)-(Pct_res%=2)
  220.   D%(0)=Screen                      ! d%() contains DFMDB
  221.   D%(1)=S%(1)
  222.   D%(2)=S%(2)
  223.   D%(3)=S%(3)
  224.   D%(4)=0
  225.   D%(5)=S%(5)
  226. Return
  227. '
  228. Procedure Iris
  229.   @Setup_bitblit
  230.   For Ev=1 To 39
  231.     P%(0)=S%(1)/2-Ev*S%(1)/80
  232.     P%(4)=P%(0)
  233.     P%(1)=S%(2)/2-Ev*S%(2)/80
  234.     P%(5)=P%(1)
  235.     P%(2)=S%(1)/2+Ev*S%(1)/80-1
  236.     P%(6)=P%(2)
  237.     P%(3)=S%(2)/2+Ev*S%(2)/80-1
  238.     P%(7)=P%(3)
  239.     Bitblt S%(),D%(),P%()
  240.   Next Ev
  241.   Bmove Scrn1,Screen,32000
  242. Return
  243. '
  244. Procedure Rndom
  245.   @Setup_bitblit
  246.   Local A$
  247.   A$=Space$(400)
  248.   For Ev=0 To 399
  249.     Dpoke Varptr(A$)+Ev*2,Ev
  250.   Next Ev
  251.   For Ev=399 Downto 0
  252.     R=Random(Ev)
  253.     Ev2=Dpeek(Varptr(A$)+R*2)
  254.     P%(0)=(Ev2 Mod 20)*Int(S%(1)/20)
  255.     P%(1)=Int(Ev2/20)*Int(S%(2)/20)
  256.     P%(2)=P%(0)+Int(S%(1)/20)
  257.     P%(3)=P%(1)+Int(S%(2)/20)
  258.     P%(4)=P%(0)
  259.     P%(5)=P%(1)
  260.     P%(6)=P%(2)
  261.     P%(7)=P%(3)
  262.     Dpoke Varptr(A$)+R*2,Dpeek(Varptr(A$)+Ev*2)
  263.     Bitblt S%(),D%(),P%()
  264.   Next Ev
  265.   Clr A$
  266. Return
  267. '
  268. Procedure Cross
  269.   @Setup_bitblit
  270.   For Ev=1 To 20
  271.     P%(0)=0
  272.     P%(1)=0
  273.     P%(2)=Ev*S%(1)/40-1
  274.     P%(3)=Ev*S%(2)/40
  275.     P%(4)=P%(0)
  276.     P%(5)=P%(1)
  277.     P%(6)=P%(2)
  278.     P%(7)=P%(3)
  279.     Bitblt S%(),D%(),P%()
  280.     P%(1)=S%(2)-P%(3)
  281.     P%(3)=S%(2)-1
  282.     P%(4)=P%(0)
  283.     P%(5)=P%(1)
  284.     P%(6)=P%(2)
  285.     P%(7)=P%(3)
  286.     Bitblt S%(),D%(),P%()
  287.     P%(0)=S%(1)-P%(2)-1
  288.     P%(2)=S%(1)-1
  289.     P%(4)=P%(0)
  290.     P%(5)=P%(1)
  291.     P%(6)=P%(2)
  292.     P%(7)=P%(3)
  293.     Bitblt S%(),D%(),P%()
  294.     P%(1)=0
  295.     P%(3)=Ev*S%(2)/40
  296.     P%(4)=P%(0)
  297.     P%(5)=P%(1)
  298.     P%(6)=P%(2)
  299.     P%(7)=P%(3)
  300.     Bitblt S%(),D%(),P%()
  301.   Next Ev
  302. Return
  303. '
  304. Procedure Assemble
  305.   @Setup_bitblit
  306.   For Ev=0 To 39
  307.     For Ev2=0 To 7
  308.       P%(1)=Ev2*S%(2)/8
  309.       P%(3)=P%(1)+S%(2)/8
  310.       If Even(Ev2)
  311.         P%(0)=Ev*S%(1)/40
  312.       Else
  313.         P%(0)=S%(1)-Ev*S%(1)/40-S%(1)/40
  314.       Endif
  315.       P%(2)=P%(0)+S%(1)/40-1
  316.       P%(4)=P%(0)
  317.       P%(5)=P%(1)
  318.       P%(6)=P%(2)
  319.       P%(7)=P%(3)
  320.       Bitblt S%(),D%(),P%()
  321.     Next Ev2
  322.   Next Ev
  323. Return
  324. '
  325. Procedure Square
  326.   @Setup_bitblit
  327.   For Ev=0 To 99
  328.     Ev2=Ev*2-Odd(Int(Ev*2/10))+99*(Ev>49)+2*(Odd(Int(Ev*2/10)) And Ev>49)
  329.     P%(0)=(Ev2 Mod 10)*Int(S%(1)/10)
  330.     P%(1)=Int(Ev2/10)*Int(S%(2)/10)
  331.     P%(2)=P%(0)+Int(S%(1)/10)
  332.     P%(3)=P%(1)+Int(S%(2)/10)
  333.     P%(4)=P%(0)
  334.     P%(5)=P%(1)
  335.     P%(6)=P%(2)
  336.     P%(7)=P%(3)
  337.     Bitblt S%(),D%(),P%()
  338.   Next Ev
  339. Return
  340.